# $Id: c2s.tcl 47 2007-09-11 00:12:23Z khomoutov $
# Client-to-server (hub) part of DC.

namespace eval ::dcclient {
	variable hubs [list]
	variable result

	namespace export c2s_login

	### hooks

	hook new c2s_connected
	hook new c2s_disconnected
	hook add c2s_remote_disconnect [my OnSockRemoteDisconnect] -iscommand -prio 100
	hook add c2s_logged_in  [mycmd OnLoggedIn] -iscommand -prio 100
	hook add c2s_in_raw     [mycmd ParseStanza] -iscommand -prio 100
	hook add c2s_in_command [mycmd ProcessCommand] -iscommand -prio 100
}

# args: same as of ::dccore::connect, plus
#  -nick NICK -- sign in as $nick;
#  -pass[word] -- use password to become op, if requested.
# TODO implement passing of command "pick another nick" callback.
proc ::dcclient::c2s_login args {
	variable hubs
	variable hubid
	variable result

	if {![info exists hubid]} { set hubid 0 }
	set hub hub$hubid

	set cmd [list connect]

	foreach {opt val} $args {
		switch -- $opt {
			-nick { set nick $val }
			-password -
			-pass { set password $val }
			default { lappend cmd $opt $val }
		}
	}

	# default port, if not provided:
	if {[lsearch $cmd -port] < 0} {
		lappend cmd -port 411
	}

	assert_required_args_present nick -nick

	set sock [eval $cmd]

	lappend hubs $hub
	variable $hub
	upvar 0 $hub state
	set state(sock) $sock

	set state(nick) $nick
	if {[info exists password]} { set state(password) $password }

	fileevent $sock readable \
		[mycmd SockParseInputData $hub $sock]

	hook run c2s_connected $hub

	::dccore::command hookonce $sock {$Lock} [mycmd OnGotLock]

	debugmsg login "$hub: logging in"

	vwait [my result]

	lassign $result code msg
	switch -- $code {
		OK {
			incr hubid
			return $hub
		}
		ERROR {
			return -code error $msg
		}
		default {
			error "Unknown login result: $result"
		}
	}
}

proc ::dcclient::SockParseInputData {hub sock} {
	if {[eof $sock]} {
		hook run c2s_remote_disconnect $hub $sock
	} else {
		variable $sock; upvar 0 ${sock}(acc) acc
		append acc [read $sock]
		set from 0; set dp 0
		while 1 {
			set dp [string first | $acc $dp]
			if {$dp >= 0} {
				set stanza [string range $acc $from [expr {$dp - 1}]]
				eval [list hook run c2s_in_raw $hub #[info level] stanza]
				incr dp; set from $dp
			} else {
				set acc [string range $acc $from end]
				break
			}
		}
	}
}

proc ::dcclient::ParseStanza {hub level vstanza} {
	upvar $level $vstanza stanza

	::dccore::ParseStanza $stanza cmd param

	set first [string index $cmd 0]
	switch -- $first {
		$ {
			hook run c2s_in_command $hub #[info level] cmd param
		}
		< {
			# in this case $cmd is <nick> and $parm is message
			set nick [string range $cmd 1 end-1]
			hook run c2s_in_pub_msg $hub #[info level] nick param
		}
		default {
			# TODO process bad command format
		}
	}
}

proc ::dcclient::ProcessCommand {hub level vcmd vparam} {
	upvar $level $vcmd cmd $vparam param

	switch -- $cmd {
		$Lock {
			lassign [split $param " "] lock pk
			set pkey [lindex [split $pk =] 1]
			set arglist {lock pkey}
		}
		$HubName -
		$Hello -
		$Quit - 
		$ForceMove {
			set arglist param
		}
		$MyINFO {
			set arglist {nick interest speed speedclass email sharesize}
			eval [list ParseCmdParamMyInfo $param] $arglist
		}
		$Search {
			set arglist {who sizerestricted isminsize  size type keywords}
			eval [list ParseCmdParamSearch $param] $arglist
		}
		$To: {
			set arglist {receiver sender msg}
			eval [list ParseCmdParamTo $param] $arglist
		}
		$NickList -
		$OpList {
			set arglist users
			if {$param == ""} {
				set users [list]
			} else {
				set users [split \
					[string map {$$ |} [string trimright $param $]] |]
			}
		}
		$ConnectToMe {
			lassign [split $param] mynick sender
			lassign [split $sender :] host port
			set arglist {mynick host port}
		}
		$RevConnectToMe {
			lassign [split $param] sender mynick
			set arglist {mynick sender}
		}
		$NON_EXISTENT_NO_ARG_COMMAND {
			set arglist ""
		}
		default {
			hook run c2s_in_unknown_cmd $hub #[info level] cmd param
			return
		}
	}

	# TODO UGLY HACK:
	variable $hub
	upvar 0 $hub state
	variable ::dccore::$state(sock)
	upvar 0 ::dccore::$state(sock) sockstate

	set hookonce hookonce,$cmd
	if {[info exists sockstate($hookonce)]} {
		set script $sockstate($hookonce)
		unset sockstate($hookonce)
		lappend script $hub #[info level]
		eval $script $arglist
	} else {
		eval [list hook run \
			c2s_in_cmd_[string tolower [string range $cmd 1 end]] \
			$hub #[info level]] $arglist
	}
}

# $ALL <nick> <interest>$ $<speed>$<e-mail>$<sharesize>$
proc ::dcclient::ParseCmdParamMyInfo {param \
	vnick vinterest vspeed vspeedclass vemail vsharesize} {

	upvar 1 $vnick nick $vinterest interest $vspeed speed \
		$vspeedclass speedclass $vemail email $vsharesize sharesize

	# nick:
	set from 0
	set ix [string first " " $param]
	if {$ix < 0} return ;# TODO handle bad command format
	set nick [string range $param 0 [expr {$ix - 1}]]

	# interest:
	set from [expr {$ix + 1}]
	set ix [string first \$ $param $from]
	if {$ix < 0} return ;# TODO handle bad command format
	set interest [string range $param $from [expr {$ix - 1}]]

	lassign [split [string range $param [expr {$ix + 3}] end-1] \$] \
		speed email sharesize

	# parse speed to speed token and speed class:
	set class [scan [string index $speed end] %c]
	if {$class < 0x20} {
		set speed [string range $speed 0 end-1]
		set speedclass [lindex {
			normal
			normal/away
			normal/away
			fileserver
			fileserver
			fileserver/away
			fileserver/away
			speeduser
			speeduser
			speeduser/away
			speeduser/away
		} [expr {$class - 1}]]
		if {$speedclass == ""} {
			# TODO graceful "bad format" handler
			error "bad speed class: $class"
		}
	} else {
		set speedclass UNKNOWN
	}
}

# $Search <clientip>:<clientport> <searchstring>
# <sizerestricted>?<isminimumsize>?<size>?<datatype>?<searchpattern>
proc ::dcclient::ParseCmdParamSearch {param \
		vwho vsizerestricted visminsize vsize vtype vkeywords} {
	upvar 1 $vwho who \
		$vsizerestricted sizerestricted $visminsize isminsize $vsize size \
		$vtype type $vkeywords keywords

	variable ::dccore::mediatypes

	# "who":
	set from 0
	set ix [string first " " $param]
	if {$ix < 0} { error #1 } ;# TODO handle bad command format
	set who [string range $param 0 [expr {$ix - 1}]]

	# is size restricted?
	set from [incr ix]
	set ix [string first ? $param $from]
	if {$ix < 0} { error #2 } ;# TODO handle bad command format
	set sizerestricted [string range $param $from [expr {$ix - 1}]]
	switch -- $sizerestricted {
		T { set sizerestricted true }
		F { set sizerestricted false }
		default {
			# TODO handle bad command format
			error "sizerestricted: expected F or T, got: $sizerestricted"
		}
	}

	# is minimum size restricted?
	set from [incr ix]
	set ix [string first ? $param $from]
	if {$ix < 0} { error #4 } ;# TODO handle bad command format
	set isminsize [string range $param $from [expr {$ix - 1}]]
	switch -- $isminsize {
		T { set isminsize true }
		F { set isminsize false }
		default {
			# TODO handle bad command format
			error "isminsize: expected F or T, got: $isminsize"
		}
	}

	# size restriction:
	set from [incr ix]
	set ix [string first ? $param $from]
	if {$ix < 0} { error #6 } ;# TODO handle bad command format
	set size [string range $param $from [expr {$ix - 1}]]

	# data type:
	set from [incr ix]
	set ix [string first ? $param $from]
	if {$ix < 0} { error #7 } ;# TODO handle bad command format
	set tix [string range $param $from [expr {$ix - 1}]]
	set type [lindex $mediatypes [expr {$tix - 1}]]
	if {$type == ""} {
		# TODO handle bad command format
		error "Search: unknown file type: $tix"
	}

	# search keywords (or TTH):
	set from [incr ix]
	if {[string equal [string range $param $from [expr {$from + 3}]] TTH:]} {
		if {![string equal $type TTH]} {
			#error "TTH found but type isn't TTH"
			puts "PROTOCOL_ERROR: TTH found but type isn't TTH"
			set type TTH
		}
		set keywords [list [string range $param [expr {$from + 4}] end]]
	} else {
		set keywords [split [string range $param $from end]]
	}
}

proc ::dcclient::ParseCmdParamTo {param vreceiver vsender vmsg} {
	upvar 1 $vreceiver receiver $vsender sender $vmsg msg

	set from 0
	set ix [string first " " $param]
	if {$ix < 0} return ;# TODO handle bad protocol error
	set receiver [string range $param 0 [expr {$ix - 1}]]

	set from [incr ix]
	set ix [string first " " $param $from]
	if {$ix < 0} return ;# TODO handle bad protocol error
	set keyword [string range $param $from [expr {$ix - 1}]]
	if {![string equal $keyword From:]} return ;# TODO handle...

	set from [incr ix]
	set ix [string first " " $param $from]
	if {$ix < 0} return ;# TODO handle bad protocol error
	set sender [string range $param $from [expr {$ix - 1}]]

	incr ix
	if {![string equal [string index $param $ix] $]} return ;# TODO handle...
	set from [incr ix]
	set ix [string first " " $param $from]
	if {$ix < 0} return ;# TODO handle bad protocol error
	set nick [string range $param $from [expr {$ix - 1}]]
	if {![string match <*> $nick]} return ;# TODO handle...
	set nick [string range $nick 1 end-1]
	if {![string equal $sender $nick]} return ;# TODO handle

	set msg [string range $param [expr {$ix + 1}] end]
}

proc ::dcclient::OnGotLock {hub level vlock vpk} {
	variable $hub
	upvar 0 $hub state
	upvar 0 state(sock) sock
	upvar $level $vlock lock $vpk pk

	debugmsg login "$hub: got \$Lock: $lock| Pk: $pk|"

	::dccore::command hookonce $sock \
		 {$ValidateDenide} [mycmd OnBadNick] \
		 {$GetPass}        [mycmd OnPassReq] \
		 {$Hello}          [mycmd OnAccepted false]

	set key [::dccore::genkey $lock [fconfigure $sock -encoding]]
	puts -nonewline $sock "\$Key $key|\$ValidateNick $state(nick)|"

	debugmsg login "$hub: sent \$Key and \$ValidateNick"
}

# TODO implement calling of "pick another nick" callback if available.
proc ::dcclient::OnBadNick {hub args} {
	variable $hub
	upvar 0 $hub state
	variable result

	shutdown $state(sock)
	set result {ERROR "Nick denied (possibly occupied by someone else)"}
	debugmsg login "$bug: \$ValidateDenide received, bailing out"
}

proc ::dcclient::OnPassReq {hub args} {
	variable $hub
	upvar 0 $hub state
	upvar 0 state(sock) sock

	if {[info exists state(password)]} {
		::dccore::command hookonce $sock \
			{$BadPass}   [mycmd OnBadPass] \
			{$LogedIn}   [mycmd OnBecameOp] \
			{$Hello}     [mycmd OnAccepted false]
		puts -nonewline $sock "\$MyPass $state(password)|"
	} else {
		shutdown $sock
		variable result
		set result {ERROR "Password required but not provided"}
	}
}

proc ::dcclient::OnBecameOp {hub args} {
	variable $hub
	upvar 0 $hub state

	::dccore::command hookonce $state(sock) \
		{$Hello}    [mycmd OnAccepted true]
}

# TODO supplant [lappend] by something like [lmerge]
proc ::dcclient::OnAccepted {op hub args} {
	variable $hub
	upvar 0 $hub state

	lappend state(users) $state(nick)
	set state(operator) $op

	set myinfo [genmyinfo \
		-nick $state(nick) \
		-interest "pr0n [gentags]" \
		-speed LAN(T3) \
		-sharesize [expr {8000 * wide(1024) * 1024}] \
	]
	puts -nonewline $state(sock) "\$Version 1,0091|\$MyINFO \$ALL $myinfo|"

	GetNickList $hub

	# TODO actually we should wait own $MyINFO back to complete the login sequence...
	variable result
	set result OK
}

proc ::dcclient::OnLoginComplete {hub args} {
	debugmsg login "$hub: logged in"
}

# TODO probably make speed* lists and arrays namespaced variables
#      so they would have possibility to be shared by other code.
proc ::dcclient::genmyinfo args {
	variable speedtypes
	variable speedclasses

	array set speedclassmap {
		normal          1
		normal/away     2
		fileserver      4
		fileserver/away 6
		speeduser       8
		speeduser/away  10
	}

	set interest ""
	set email ""
	set speedclass normal
	set away false

	foreach {opt val} $args {
		switch -- $opt {
			-nick { set nick $val }
			-interest { set interest $val }
			-speed {
				if {[lsearch $speedtypes $val] >= 0} {
					set speed $val
				} else {
					return -code error "invalid speed \"$val\":\
						must be one of [join $speedtypes {, }]"
				}
			}
			-speedclass {
				if {[lsearch $speedclasses $val] >= 0} {
					set speedclass $val
				} else {
					return -code error "invalid speed class \"$val\":\
						must be one of [join $speedclasses {, }]"
				}
			}
			-away {
				if {[string is boolean $val]} {
					set away $val
				} else {
					return -code error "invalid away status \"$val\":\
						must be boolean value"
				}
			}
			-email { set email $val }
			-sharesize { set sharesize $val }
			default {
				return -code error "bad option \"$opt\":\
					must be one of -nick, -interest, -speed, -speedclass,\
					-away, -email or -sharesize"
			}
		}
	}

	assert_required_args_present nick -nick speed -speed sharesize -sharesize

	if {$away} { append speedclass /away }
	set speedicon $speedclassmap($speedclass)

	return [format {%s %s$ $%s%c$%s$%s$} \
		$nick $interest $speed $speedicon $email $sharesize]
}

proc ::dcclient::gentags {} {
	#return "<tcldc V:0.1,M:P,H:1/0/0,S:1,O:1024>"
	return "<++ V:0.691,M:A,H:1/0/0,S:10,O:1024>"
}

proc ::dcclient::gensearchquery args {
	variable ::dccore::mediatypes

	set type any
	set sizerestricted false
	set isminsize true ;# the default in DC protocol for some reason
	set size 0

	foreach {opt val} $args {
		switch -- $opt {
			-ip -
			-ipaddr -
			-address {
				if {![string_is_ip $val]} {
					return -code error "bad IP address \"$val\""
				}
				set ipaddr $val
					
			}
			-port {
				if {![string is integer $val] || $val < 1 || $val > 65535} {
					return -code error "bad port number \"$val\":\
						must be integer in range \[1..65535\]"
				}
				set port $val
			}
			-minsize {
				if {$sizerestricted && !$isminsize} {
					return -code error "-minsize and -maxsize cannot be used together"
				}
				if {![string is integer $val] || $val < 1} {
					return -code error "bad file size: must be integer >= 1"
				}
				set sizerestricted true
				set isminsize true
				set size $val
			}
			-maxsize {
				if {$sizerestricted && $isminsize} {
					return -code error "-minsize and -maxsize cannot be used together"
				}
				if {![string is integer $val] || $val < 1} {
					return -code error "bad file size: must be integer >= 1"
				}
				set sizerestricted true
				set isminsize false
				set size $val
			}
			-type -
			-media -
			-mediatype {
				set type [mediatypeindex $val]
			}
			-keywords {
				set keywords $val
			}
			default {
				return -code error "bad option \"$opt\":\
					must be one of -minsize, -maxsize, -type or -keywords"
			}
		}
	}

	assert_required_args_present ipaddr -address port -port keywords -keywords

	set tokens [if {$type == 9} { # TTH
		if {[llength $keywords] != 1
		|| ![string is ascii [lindex $keywords 0]]} {
			return -code error "search keyword donesn't appear to be a TTH"
		}
		string toupper [lindex $keywords 0]
	} else {
		set sane [list]
		foreach keyword $keywords {
			set item [string map {
				$    _
				|    _
			} [string trim $keyword]]
			if {$item != ""} {
				lappend sane $item
			}
		}
		if {[llength $sane] < 1} {
			return -code error "bad search keywords: there must be at least one non-empty keyword"
		}
		join $sane $
	}]

	format {%s:%u %s?%s?%u?%s?%s} \
		$ipaddr $port \
		[expr {$sizerestricted ? T : F}] \
		[expr {$isminsize ? T : F}] \
		$size $type $tokens
}

proc ::dcclient::GetNickList hub {
	variable $hub
	upvar 0 $hub state
	upvar 0 state(sock) sock

	::dccore::command hookonce $sock \
		{$NickList}    [mycmd OnNickList] \
		{$OpList}      [mycmd OnOpList]

	puts -nonewline $sock {$GetNickList|}
}

proc ::dcclient::OnNickList {hub level vnicks} {
	variable $hub
	upvar 0 $hub state
	upvar $level $vnicks nicks

	set state(users) [lsort -unique [concat $state(users) $nicks]]

	debugmsg hub "USERS: $state(users)"
}

proc ::dcclient::OnOpList {hub level vops} {
	variable $hub
	upvar 0 $hub state
	upvar $level $vops ops

}

proc ::dcclient::SockShutdown sock {
	variable $sock
	unset $sock

	::dccore::shutdown $sock

	hook run c2s_disconnected
}

proc ::dcclient::OnSockRemoteDisconnect {hub sock} {
	debugmsg sock "$hub: EOF on sock, shutting down"

	variable $hub
	upvar 0 $hub state

	SockShutdown $state(sock)
	unset state
}

